Objectif : Dynamique de population des poissons d’eau douce de Bretagne

10_calcul_indicateurs_par_ope

Ce script permet de constituer les tableaux de données nécessaires à la réalisation des analyses temporelles. Plusieurs indicateurs seront calculés à l’échelle des opérations de pêches, parmi eux : les densités volumiques, de surface, les pourcentages de juvéniles, les longueurs médianes, … Ces indicateurs sont calculés par espèces, pour les juvéniles et les adultes, mais également de manière combinée (indeterminés).

Installation

Chargement des packages, fonctions et des données

## Chargement des packages ----
library(tidyverse)
library(aspe)
library(ggplot2)
library(ggthemes)
library(dplyr)
library(readxl)
## Chargement des données pré-enregistrées ----
load(file = "../processed_data/selection_pop_ope.rda")
load(file = "../processed_data/pre_traitements_donnees_env.rda")
load(file = "../processed_data/analyse_selection_especes.rda")
load(file = "../processed_data/pre_traitements_donnees_especes.rda")
#Chargement des tables ASPE ----
rdata_tables <- misc_nom_dernier_fichier(
  repertoire = "../../../../projets/ASPE/raw_data/rdata",
  pattern = "^tables")
load(rdata_tables)

mei_table <- misc_nom_dernier_fichier(
  repertoire = "../../../../projets/ASPE/raw_data/rdata",
  pattern = "^mei")
load(mei_table)
## Chargement des fonctions ----
source(file = "../R/calcul_biomasse.R")
source(file = "../R/calcul_50_percentile.R")
source(file = "../R/calcul_ecart_interquartile.R")
source(file = "../R/calcul_25_percentile.R")
source(file = "../R/calcul_75_percentile.R")
source(file = "../R/calcul_densite_surface.R")

Les indicateurs par opération de pêche

Indicateurs généraux par opération de pêche

Effectif total des espèces par opération de pêche

ope_effectif <- mei_ope_selection %>%
  group_by(ope_id, esp_code_alternatif) %>%
  distinct(mei_id, .keep_all = TRUE) %>%
  summarise(valeur = n_distinct(mei_id)) %>%
  mutate(indicateur = "effectif_total", stade = "ind") %>%
  select(ope_id, 
         esp_code_alternatif, 
         indicateur, 
         valeur, 
         stade)
ope_effectif_stade <- mei_ope_selection %>% 
  group_by(ope_id,
           esp_code_alternatif,
           stade
           ) %>%
  summarise(valeur=length(lop_effectif)) %>% 
  mutate(indicateur= "effectif_total") %>% 
  select(ope_id,
         esp_code_alternatif,
         indicateur,
         valeur,
         stade
         )

ope_effectif <- rbind (ope_effectif,ope_effectif_stade)

Biomasse des espèces par opération de pêche

# Calcul de la biomasse par opération : par espèce et par stade : 

ope_biomasse <- mei_ope_selection %>%
  group_by(ope_id,
           esp_code_alternatif,
           stade) %>%
  summarise(valeur=sum(poids_tp, na.rm = TRUE)) %>% 
  mutate(indicateur= "biomasse") %>% 
  select(ope_id,
         esp_code_alternatif,
         indicateur,
         valeur,
         stade) 

ope_biomasse <- ope_biomasse %>%
  bind_rows(ope_biomasse %>%
      filter(stade %in% c("ad", "juv")) %>%
      group_by(indicateur, ope_id, esp_code_alternatif) %>%
      summarise(stade = "ind", valeur = sum(valeur)))

Densité surfacique par opération

# Ajout des données de surfaces échantillonnées dans mei_esp_ope_selection ----
mei_ope_selection <- mei_ope_selection %>% 
  left_join (y=operation %>% 
               select (ope_id, 
                       ope_surface_calculee,
                       passage$pas_numero))
ope_densite_surf <- calcul_densite_surface(mei_ope_selection,
                                           ope_surface_calculee,
                                           ope_id,
                                           esp_code_alternatif,
                                           stade,
                                           mei_id)

Densité volumique par opération

#Ajout des données de profondeurs :
ope_param_profondeur <- ope_selection_param_env %>% 
  filter(parametre == "profondeur") %>% 
  select(ope_id,
         valeur) %>% 
  rename(profondeur=valeur) %>% 
  distinct()
densite_surf <- ope_densite_surf %>% 
  rename(valeur_ds = valeur)

ope_densite_vol<- left_join(ope_param_profondeur, densite_surf, by = "ope_id") %>% 
  mutate(valeur = valeur_ds /profondeur) %>%
  ungroup() %>% 
  mutate(indicateur = "densite_volumique") %>% 
  select(ope_id, 
         esp_code_alternatif, 
         indicateur,
         valeur,
         stade)

Pourcentage de juvéniles par opération

ope_pc_juv <- ope_effectif %>%
  mutate(indicateur = "pourcentage_juveniles")
ope_pc_juv <- ope_pc_juv %>% 
  ungroup() %>% 
  complete(ope_id,
           esp_code_alternatif,
           stade,
           indicateur,
           fill = list(valeur = 0)) %>% 
    group_by(ope_id,
             esp_code_alternatif) %>% 
  mutate(valeur = (valeur [stade == "juv"] / valeur [stade == "ind"])*100) %>% 
  filter(stade == "ind",
         !is.nan(valeur))

Indicateurs sur les mesures individuelles par opération de pêche

Longueur médiane

Calcul des longueurs médianes des tailles des individus par opération : Création de la fonction “calcul_50_percentile” :

ope_lm <- calcul_50_percentile(mei_ope_selection,
                               mei_taille,
                               ope_id,
                               esp_code_alternatif, 
                               stade)

Ecart interquartile

Calcul des écarts interquartiles des tailles des individus par opération : Création de la fonction “calcul_ecart_interquartile” :

ope_ecart_inter <- calcul_ecart_inter(mei_ope_selection,
                                      mei_taille,
                                      ope_id,
                                      esp_code_alternatif, 
                                      stade)

Percentiles 25 et 75 pour les longueurs médianes

Calcul des percentiles 25 et 75 des tailles des individus par opération : Création de la fonction “calcul_25_percentile” et “calcul_75_percentile” :

ope_p25 <- calcul_p25(mei_ope_selection,
                      mei_taille,
                      ope_id,
                      esp_code_alternatif, 
                      stade)
ope_p75 <- calcul_p75(mei_ope_selection,
                      mei_taille,
                      ope_id,
                      esp_code_alternatif, 
                      stade)

Echelle régionale (pre-données)

On calcul le pourcentage des sites prospectés où l’espèce a été trouvée :

ope_biomasse1 <- ope_biomasse %>% 
  filter (stade == "ind")

combinaisons <- expand.grid(esp_code_alternatif = unique(ope_biomasse1$esp_code_alternatif),
                            ope_id = unique(ope_biomasse$ope_id))

# Fusionner les combinaisons avec le dataframe initial
reg_pc_site_presence_esp <- combinaisons %>%
  left_join(ope_biomasse1, by = c("esp_code_alternatif", "ope_id")) %>%
  mutate(present = !is.na(indicateur)) %>%
  group_by(esp_code_alternatif) %>%
  mutate(
    stade = "ind",
    indicateur = "pourcentage_site_presence_esp",
    valeur = sum(present) / n_distinct(ope_id) * 100
  ) %>%
  select(-present)

# Affichage du résultat
print(reg_pc_site_presence_esp)
## # A tibble: 26,275 × 5
## # Groups:   esp_code_alternatif [25]
##    esp_code_alternatif ope_id indicateur                    valeur stade
##    <chr>                <int> <chr>                          <dbl> <chr>
##  1 ANG                   5131 pourcentage_site_presence_esp  83.2  ind  
##  2 CHA                   5131 pourcentage_site_presence_esp  83.3  ind  
##  3 LOF                   5131 pourcentage_site_presence_esp  91.9  ind  
##  4 TRF                   5131 pourcentage_site_presence_esp  81.3  ind  
##  5 VAI                   5131 pourcentage_site_presence_esp  74.7  ind  
##  6 LPP                   5131 pourcentage_site_presence_esp  53.7  ind  
##  7 SAT                   5131 pourcentage_site_presence_esp  45.5  ind  
##  8 BRO                   5131 pourcentage_site_presence_esp  20.5  ind  
##  9 CCO                   5131 pourcentage_site_presence_esp   1.81 ind  
## 10 EPI                   5131 pourcentage_site_presence_esp   1.81 ind  
## # ℹ 26,265 more rows

Création du tableau final empilé des indicateurs

L’ensemble des indicateurs calculés sont regroupés dans le dataframe ope_indicateur.

# Création du tableau pré-final avec tous les indicateurs calculés
ope_indicateur <- rbind(ope_lm,
                        ope_densite_surf,
                        ope_densite_vol,
                        ope_pc_juv,
                        ope_biomasse,
                        ope_effectif,
                        reg_pc_site_presence_esp)

Les années d’opérations ainsi que les identifiant des point de prélèvements sont ajoutés au tableau ope_indicateur.

# Ajout des années d'opération au site et à l'année (pop_id) et (ope_date)
ope_indicateur <- ope_indicateur %>% 
  ungroup() %>%   
  left_join(y=operation %>% 
              select(ope_id,
                     pop_id= ope_pop_id,
                     ope_date)) %>% 
  mef_ajouter_ope_date() %>% 
    select(ope_id,
           esp_code_alternatif,
           indicateur,
           valeur,
           stade,
           pop_id,
           annee)

Visualisation du tableau final de données

#Représentation graphique du tableau 
ope_indicateur%>%
  DT::datatable(rownames = FALSE)

Sauvegarde

# SAUVEGARDE ----
save(ope_indicateur,
     mei_ope_selection,
     file = "../processed_data/assemblage_tab_par_ope.rda")